home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual Foxpro 6.0 (Ent. Edition) / Vf6ent Extractor.EXE / TOOLS / GENDBC / GENDBC.PRG
Encoding:
Text File  |  1998-05-26  |  50.9 KB  |  1,350 lines
  1. ** For best results, view this file with: Courier New / Regular / 10
  2. ** TabWidth set to: 4
  3. **************************************************************************
  4. ** Program Name : GENDBC.PRG
  5. ** Creation Date: 94.12.01
  6. **
  7. ** Purpose        :    To take an existing FoxPro 3.0/5.0 database and
  8. **                    generate an output program that can be used
  9. **                    to "re-create" that database.
  10. ** Parameters    :    cOutFile - A character string that contains
  11. **                    the name of an output file.  This
  12. **                    can contain path information and
  13. **                    an extension.  If no extension is
  14. **                    supplied, one will be provided.
  15. **
  16. **                    lskipdisplay - Whether to include status
  17. **                    messages in generated output.
  18. ** Modification History:
  19. **
  20. ** 1994.12.01 KRT  Created program, runs on Build 329 of VFP
  21. ** 1994.12.02 KRT  Added GetView function and cleaned up all code
  22. ** 1994.12.05 KRT  Modified some areas and verified run on Build 335
  23. ** 1994.12.06 KRT  Added things for international conversion
  24. ** 1994.12.08 KRT  Added function ADBOBJECTS() to code
  25. ** 1994.12.12 KRT  Added commands COPY PROCEDURES TO
  26. ** 1995.01.04 KRT  Added connection properties
  27. ** 1995.01.05 KRT  Added support for long filenames - thierryp
  28. ** 1995.01.05 KRT  Added support for RI
  29. ** 1995.01.06 KRT  Added support for MS-DOS short filenames (NAME clause)
  30. ** 1995.01.08 KRT  Added status bar line
  31. ** 1995.01.26 KRT  Fixed a few file bugs and localization bug
  32. ** 1995.02.19 KRT  Took advantage of AFIELDS() command
  33. ** 1995.02.22 KRT  Fixed AUSED() bug
  34. ** 1995.03.01 KRT  Removed ON ERROR problem
  35. ** 1995.03.20 KRT  Fixed "Exclusive" Error / Procedures created before
  36. **                 Tables
  37. ** 1995.03.22 KRT  Allowed user to open database if one is not set current
  38. **                 / Set SAFETY OFF in resulting code to prevent errors
  39. **                   when validating rules/triggers that don't exist
  40. ** 1995.04.07 KRT  Put any database procedures into a seperate file to
  41. **                 prevent "Program Too Large" errors
  42. ** 1995.04.20 KRT  Only change SAFETY when appending procedures
  43. **
  44. ** 3.0b - Changes/Fixes
  45. ** 1995.09.15 KRT  Changed ADBOBJECTS() to DBF() in GETTABLE procedure.
  46. **                 This allows for "real" table names instead of alias'
  47. ** 1995.09.15 KRT  Take into account CR+LF in comments for fields
  48. ** 1995.09.15 KRT  Store Source and Object code into external file
  49. **                 So the code can be executed from the run-time version
  50. ** 1995.10.23 KRT  Changed DBF(cTableName ) to DBF(ALIAS() ) because
  51. **                 VFP will automatically add underscores where spaces
  52. **                 should be and I need to know what it did to the alias
  53. **                 [Regress]
  54. ** 1995.10.25 KRT  Added OVERWRITE to append memo's [Regress]
  55. ** 1995.10.25 KRT  Added support for CR+LF in comments for Table
  56. ** 1995.10.25 KRT  Close all tables in generated code before adding
  57. **                 Source and Object code from external file[Regress]
  58. ** 1995.10.25 KRT  Added warning about filter indices on Unique and
  59. **                 Candidate keys (Not supported via language )
  60. ** 1995.12.20 KRT  Better lookup for adding RI information to database
  61. ** 1995.12.20 KRT  Added support for filter expressions on CANDIDATE keys
  62. ** 
  63. ** 5.0 - Changes/Fixes
  64. ** 1996.03.27 KRT  Added "exact match" support for Locate command
  65. ** 1996.04.12 KRT  Added new properties for Views, Fields and Connections
  66. ** 1996.05.14 KRT  Adjusted for some logical properties return spaces
  67. ** 1996.05.16 KRT  Added even more new properties for Views
  68. ** 1996.05.16 KRT  Add M. in front of all memory variables to prevent
  69. **                 confusion with table fields and names
  70. ** 1996.06.01 KRT  Added support for Collate sequence on index files
  71. ** 1996.06.26 KRT  Added support for ParameterList in Views
  72. ** 1996.07.19 KRT  Added support for Offline Views
  73. ** 1996.08.07 KRT  Added support for comments and default values in views
  74. ** 1997.10.22 RB   Breakup data creation into procedures to eliminate 64K proc limit
  75. **************************************************************************
  76. LPARAMETERS cOutFile,lskipdisplay
  77.  
  78. PRIVATE ALL EXCEPT g_*
  79. *! Public Variables
  80. IF SET("TALK") = "ON"                        && To restore SET TALK after use
  81.     SET TALK OFF                            && -- Have to do it this way so
  82.     m.g_cSetTalk = "ON"                        && -- nothing get's on screen
  83. ELSE
  84.     m.g_cSetTalk = "OFF"
  85. ENDIF
  86. m.g_lskipdisplay = IIF(vartype(lskipdisplay)#"L",.F.,lskipdisplay)
  87. m.g_cFullPath = SET("FULLPATH")                && To restore old FULLPATH setting
  88. m.g_cOnError = ON("ERROR")                    && To restore old ON ERROR condition
  89. m.g_cSetDeleted = SET("DELETED")            && To restore SET DELETED later
  90. m.g_cSetStatusBar = SET("STATUS BAR")        && To restore STATUS bar
  91. m.g_cStatusText = SYS(2001, "MESSAGE", 1)    && To restore text that may be on it
  92. m.g_nMax = 7                                && For status line information
  93. m.g_nCurrentStat = 1                            && For status line information
  94. m.g_cFilterExp = ""                         && For Non-Supported Filter Info
  95. DIMENSION g_aProcs[1]
  96. SET DELETED ON
  97. SET FULLPATH ON
  98. IF m.g_cSetStatusBar = "OFF"
  99.     SET STATUS BAR ON
  100. ENDIF
  101.  
  102. *! Our generic error handling routine
  103. ON ERROR DO GenDBC_Error WITH MESSAGE(), LINENO()
  104.  
  105. **************************************************************************
  106. ** Constants
  107. **************************************************************************
  108. #DEFINE CRLF CHR(13) + CHR(10)
  109. #DEFINE DBCS_LOC             "81 82 86 88"
  110.  
  111. **************************************************************************
  112. ** Error Messages
  113. **************************************************************************
  114. #DEFINE NO_DATABASE_IN_USE_LOC    "No Database is in use. " + ;
  115.                                 "This program must have a database " + ;
  116.                                 "available."
  117. #DEFINE INVALID_PARAMETERS_LOC    "Invalid Parameters..." + CRLF + ;
  118.                                 "An output file must be specified." + CRLF +;
  119.                                 'ie: DO GENDBC WITH "filename.prg"'
  120. #DEFINE INVALID_DESTINATION_LOC    "Invalid Destination File "
  121. #DEFINE NO_TEMP_FILE_LOC        "Could not create temporary file: "
  122. #DEFINE NO_OUTPUT_WRITTEN_LOC   "Could not create or write to output file"
  123. #DEFINE ERROR_TITLE_LOC            "Aborting GenDBC..."
  124. #DEFINE UNRECOVERABLE_LOC        "Unrecoverable Error: "
  125. #DEFINE AT_LINE_LOC                " At Line: "
  126. #DEFINE NO_FIND_LOC                "Could not set RI Information."
  127. #DEFINE NO_FILE_FOUND_LOC        "Warning! No Procedure File Found!"
  128. #DEFINE GETFILE_GEN_LOC            "Generate..."
  129. #DEFINE NOT_SUPPORTED_LOC        "Filters on PRIMARY keys are not supported at this time. " + ;
  130.                                 "A comment will be added to your output file specifying the filters."
  131. #DEFINE NS_COMMENT_LOC            "****** These filters need to be added manually ******"
  132. #DEFINE WARNING_TITLE_LOC        "GenDBC Warning..." 
  133.  
  134. **************************************************************************
  135. ** Comments And Other Information
  136. **************************************************************************
  137. #DEFINE MESSAGE_START_LOC    "Creating database..."
  138. #DEFINE MESSAGE_DONE_LOC    "Finished."
  139. #DEFINE MESSAGE_MAKETABLE_LOC     "Creating table "
  140. #DEFINE MESSAGE_MAKEVIEW_LOC    "Creating view "
  141. #DEFINE MESSAGE_MAKECONN_LOC    "Creating connection "
  142. #DEFINE MESSAGE_MAKERELATION_LOC    "Creating persistent relations..."
  143. #DEFINE MESSAGE_MAKERI_LOC    "Creating relational integrity rules..."
  144. #DEFINE MESSAGE_END_LOC        "..."
  145. #DEFINE BEGIN_RELATION_LOC        "*************** Begin Relations Setup **************"
  146. #DEFINE BEGIN_TABLE_LOC            "Table setup for "
  147. #DEFINE BEGIN_INDEX_LOC            "Create each index for "
  148. #DEFINE BEGIN_PROP_LOC            "Change properties for "
  149. #DEFINE BEGIN_VIEW_LOC            "View setup for "
  150. #DEFINE BEGIN_PROC_LOC            "Procedure Re-Creation"
  151. #DEFINE BEGIN_CONNECTIONS_LOC    "Connection Definitions"
  152. #DEFINE BEGIN_RI_LOC            "Referential Integrity Setup"
  153. #DEFINE OPEN_DATABASE_LOC        "Select Database..."
  154. #DEFINE SAVE_PRG_NAME_LOC        "Enter output program name..."
  155. #DEFINE NO_MODIFY_LOC            "*** WARNING *** DO NOT MODIFY THIS FILE IN ANY WAY! *** WARNING ***"
  156. #DEFINE TABLE_NAME_LOC            "*        Table Name: "
  157. #DEFINE PRIMARY_KEY_LOC            "*       Primary Key: "
  158. #DEFINE FILTER_EXP_LOC            "* Filter Expression: "
  159. #DEFINE HEADING_1_LOC    "* *********************************************************" + CRLF + ;
  160.                         "* *" + CRLF
  161. #DEFINE HEADING_2_LOC    "* *" + CRLF + ;
  162.                         "* *********************************************************" + CRLF + ;
  163.                         "* *" + CRLF + ;
  164.                         "* * Description:" + CRLF + ;
  165.                         "* * This program was automatically generated by GENDBC" + CRLF + ;
  166.                         "* * Version 2.26.67" + CRLF + ;
  167.                         "* *" + CRLF + ;
  168.                         "* *********************************************************" + CRLF
  169.  
  170. *! Make sure a database is open
  171. IF EMPTY(DBC())
  172.     m.g_cFullDatabase = GETFILE("DBC", OPEN_DATABASE_LOC, GETFILE_GEN_LOC, 0)
  173.     IF EMPTY(m.g_cFullDatabase)
  174.         FatalAlert(NO_DATABASE_IN_USE_LOC, .F.)
  175.     ENDIF
  176.     OPEN DATABASE (m.g_cFullDatabase)
  177. ENDIF
  178.  
  179. *! Set global variable to the database name and format it
  180. m.g_cDatabase = DBC()
  181. IF RAT("\", m.g_cDatabase) > 0
  182.     m.g_cDatabase = SUBSTR(m.g_cDatabase, RAT("\", m.g_cDatabase) + 1)
  183. ENDIF
  184.  
  185. *! Get the fullpath of database
  186. m.g_cFullDatabase = DBC()
  187.  
  188. *! Check for valid parameters
  189. IF PARAMETERS() < 1 OR TYPE("cOutFile")#"C" OR EMPTY(cOutFile)
  190.     m.cOutFile = ""
  191.     m.cOutFile = PUTFILE(SAVE_PRG_NAME_LOC, (SUBSTR(m.g_cDatabase, 1, RAT(".", m.g_cDatabase)) + "PRG"), "PRG")
  192.     IF EMPTY(cOutFile)
  193.         FatalAlert(INVALID_PARAMETERS_LOC, .F.)
  194.     ENDIF
  195. ENDIF
  196.  
  197. *! Check for proper extensions or add one if none specified
  198. IF RAT(".PRG", m.cOutFile) = 0 AND RAT(".", m.cOutFile) = 0
  199.     m.cOutFile = m.cOutFile + ".PRG"
  200. ENDIF
  201.  
  202. *! Make sure the output file is valid
  203. m.hFile = FCREATE(m.cOutFile)
  204. IF m.hFile <= 0
  205.     FatalAlert(INVALID_DESTINATION_LOC + m.cOutFile, .F.)
  206. ENDIF
  207.  
  208. FCLOSE(m.hFile)
  209. ERASE (m.cOutFile)
  210.  
  211. *! Remember all our tables that are open for this database
  212. m.g_nTotal_Tables_Used = AUSED(g_aAlias_Used)
  213. IF m.g_nTotal_Tables_Used > 0
  214.     DIMENSION m.g_aTables_Used(m.g_nTotal_Tables_Used)
  215.  
  216.     *! Get Real Names of tables opened
  217.     FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
  218.         g_aTables_Used(m.nLoop) = DBF(g_aAlias_Used(m.nLoop, 1))
  219.     ENDFOR
  220. ENDIF
  221.  
  222. *! Get number of tables contained in database
  223. m.nTotal_Tables = ADBOBJECTS(aAll_Tables, "Table")
  224. m.g_nMax = m.g_nMax + m.nTotal_Tables
  225. Stat_Message()
  226.  
  227. *! Get number of views contained in database
  228. m.nTotal_Views = ADBOBJECTS(aAll_Views, "View")
  229. m.g_nMax = m.g_nMax + m.nTotal_Views
  230. Stat_Message()
  231.  
  232. *! Get number of connections contained in database
  233. m.nTotal_Connections = ADBOBJECTS(aAll_Connections, "Connection")
  234. m.g_nMax = m.g_nMax + m.nTotal_Connections
  235. Stat_Message()
  236.  
  237. *! Get number of relations contained in database
  238. m.nTotal_Relations = ADBOBJECTS(aAll_Relations, "Relation")
  239. m.g_nMax = m.g_nMax + m.nTotal_Relations
  240. Stat_Message()
  241. CLOSE DATABASE
  242.  
  243. SELECT 0
  244. *! Check for this database... If it's there, we must have left it
  245. *! here because of an error last time.
  246. IF FILE("GENDBC.DBF")
  247.     ERASE "GENDBC.DBF"
  248.     ERASE "GENDBC.FPT"
  249. ENDIF
  250.  
  251. CREATE TABLE GenDBC (Program M)
  252. APPEND BLANK
  253. USE
  254.  
  255. **************************
  256. *** Get Stored Procedures
  257. **************************
  258. *! Create an output file that will be appended to the database
  259. *! as procedures
  260. m.cFile = UPPER(SUBSTR(m.cOutFile, 1, RAT(".", m.cOutFile))) + "krt"
  261.  
  262. *! Place Header Information For Source/Object
  263. m.hFile = FCREATE(m.cFile)
  264. IF m.hFile <= 0
  265.     FCLOSE(m.hFile)
  266.     FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
  267. ENDIF
  268.  
  269. FPUTS(m.hFile, NO_MODIFY_LOC)
  270. FCLOSE(m.hFile)
  271.  
  272. *! No we are going to copy the object and source code
  273. *! For the stored procedures
  274. COMPILE DATABASE (m.g_cFullDatabase)
  275. USE (m.g_cFullDatabase)
  276. LOCATE FOR Objectname = 'StoredProceduresSource'
  277. IF FOUND()
  278.     COPY MEMO Code TO (m.cFile) ADDITIVE
  279. ENDIF
  280. ADIR(aTemp, m.cFile)
  281. m.nSourceSize = aTemp(1, 2) - LEN(NO_MODIFY_LOC)
  282.  
  283. LOCATE FOR Objectname = 'StoredProceduresObject'
  284. IF FOUND()
  285.     COPY MEMO Code TO (m.cFile) ADDITIVE
  286. ENDIF
  287. USE
  288.  
  289. *! Open the database again
  290. OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
  291.  
  292. ADIR(aTemp, m.cFile)
  293.  
  294. *! Check for actual output file being created sans header
  295. IF aTemp(1, 2) > LEN(NO_MODIFY_LOC) + 2
  296.     **************************
  297.     *** Make the output file
  298.     *** re-create the proced-
  299.     *** ure file via code.
  300.     **************************
  301.     m.hOutFile = FCREATE("GenDBC.$$$")
  302.     IF m.hOutFile <= 0
  303.         = FCLOSE(m.hFile)
  304.         = FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
  305.     ENDIF
  306.     WriteFile(m.hOutFile, "")
  307.     WriteFile(m.hOutFile, "********* " + BEGIN_PROC_LOC + " *********")
  308.     WriteFile(m.hOutFile, "IF !FILE([" + SUBSTR(m.cFile, RAT("\", m.cFile) + 1) + "])")
  309.     WriteFile(m.hOutFile, "    ? [" + NO_FILE_FOUND_LOC + "]")
  310.     WriteFile(m.hOutFile, "ELSE")
  311.     WriteFile(m.hOutFile, "    CLOSE DATABASE")
  312.     WriteFile(m.hOutFile, "    USE '" +  m.g_cDatabase + "'")
  313.     WriteFile(m.hOutFile, "    g_SetSafety = SET('SAFETY')")
  314.     WriteFile(m.hOutFile, "    SET SAFETY OFF")
  315.     WriteFile(m.hOutFile, "    LOCATE FOR Objectname = 'StoredProceduresSource'")
  316.     WriteFile(m.hOutFile, "    IF FOUND()")
  317.     WriteFile(m.hOutFile, "        APPEND MEMO Code FROM [" + SUBSTR(m.cFile, RAT("\", m.cFile) + 1) + "] OVERWRITE")
  318.     WriteFile(m.hOutFile, "        REPLACE Code WITH SUBSTR(Code, " + ALLTRIM(STR(LEN(NO_MODIFY_LOC) + 3)) + ", " + ALLTRIM(STR(m.nSourceSize - 2)) + ")")
  319.     WriteFile(m.hOutFile, "    ENDIF")
  320.     WriteFile(m.hOutFile, "    LOCATE FOR Objectname = 'StoredProceduresObject'")
  321.     WriteFile(m.hOutFile, "    IF FOUND()")
  322.     WriteFile(m.hOutFile, "        APPEND MEMO Code FROM [" + SUBSTR(m.cFile, RAT("\", m.cFile) + 1) + "] OVERWRITE")
  323.     WriteFile(m.hOutFile, "        REPLACE Code WITH SUBSTR(Code, " + ALLTRIM(STR(LEN(NO_MODIFY_LOC) + m.nSourceSize + 1)) + ")")
  324.     WriteFile(m.hOutFile, "    ENDIF")
  325.     WriteFile(m.hOutFile, "    SET SAFETY &g_SetSafety")
  326.     WriteFile(m.hOutFile, "    USE")
  327.     WriteFile(m.hOutFile, "    OPEN DATABASE [" + m.g_cDatabase + "]")
  328.     WriteFile(m.hOutFile, "ENDIF")
  329.     WriteFile(m.hOutFile, "")
  330.     FCLOSE(m.hOutFile)
  331.     USE GenDBC EXCLUSIVE
  332.     APPEND MEMO Program FROM "GENDBC.$$$"
  333.     ERASE "GENDBC.$$$"
  334.     USE
  335. ELSE
  336.     ERASE (m.cFile)
  337. ENDIF
  338. Stat_Message()
  339.  
  340. * Write out database creation routines
  341. UpdateProcArray("DisplayStatus(["+MESSAGE_START_LOC+"])")
  342. UpdateProcArray("CLOSE DATA ALL")
  343. UpdateProcArray("CREATE DATABASE '" + m.g_cDatabase + "'")
  344.  
  345. **************************
  346. *** Get Tables
  347. **************************
  348. IF m.nTotal_Tables > 0
  349.     FOR m.nLoop = 1 TO m.nTotal_Tables
  350.         DO GetTable WITH ALLTRIM(aAll_Tables(m.nLoop)), "GenDBC.tmp"
  351.         Stat_Message()
  352.         USE GenDBC EXCLUSIVE
  353.         APPEND MEMO Program FROM "GenDBC.tmp"
  354.         USE
  355.         ERASE "GenDBC.tmp"
  356.         UpdateProcArray("DisplayStatus(["+MESSAGE_MAKETABLE_LOC+aAll_Tables(m.nLoop)+MESSAGE_END_LOC+"])")
  357.         UpdateProcArray("MakeTable_"+FixName(aAll_Tables(m.nLoop))+"()")
  358.     ENDFOR
  359. ENDIF
  360.  
  361. **************************
  362. *** Get Connections
  363. **************************
  364. IF m.nTotal_Connections > 0
  365.     FOR m.nLoop = 1 TO m.nTotal_Connections
  366.         DO GetConn WITH aAll_Connections(m.nLoop), "GenDBC.tmp"
  367.         Stat_Message()
  368.         USE GenDBC EXCLUSIVE
  369.         APPEND MEMO Program FROM "GenDBC.tmp"
  370.         USE
  371.         ERASE "GenDBC.tmp"
  372.         UpdateProcArray("DisplayStatus(["+MESSAGE_MAKECONN_LOC+aAll_Connections(m.nLoop)+MESSAGE_END_LOC+"])")
  373.         UpdateProcArray("MakeConn_"+FIXNAME(aAll_Connections(m.nLoop))+"()")
  374.     ENDFOR
  375. ENDIF
  376.  
  377. **************************
  378. *** Get Views
  379. **************************
  380. IF m.nTotal_Views > 0
  381.     FOR m.nLoop = 1 TO m.nTotal_Views
  382.         DO GetView WITH ALLTRIM(aAll_Views(m.nLoop)), "GenDBC.tmp"
  383.         Stat_Message()
  384.         USE GenDBC EXCLUSIVE
  385.         APPEND MEMO Program FROM "GenDBC.tmp"
  386.         USE
  387.         ERASE "GenDBC.tmp"
  388.         UpdateProcArray("DisplayStatus(["+MESSAGE_MAKEVIEW_LOC+aAll_Views(m.nLoop)+MESSAGE_END_LOC+"])")
  389.         UpdateProcArray("MakeView_"+FIXNAME(aAll_Views(m.nLoop))+"()")
  390.     ENDFOR
  391. ENDIF
  392.  
  393. **************************
  394. *** Get Relations
  395. **************************
  396. IF m.nTotal_Relations > 0
  397.     USE GenDBC EXCLUSIVE
  398.     REPLACE Program WITH BEGIN_RELATION_LOC + CRLF ADDITIVE
  399.     UpdateProcArray("DisplayStatus(["+MESSAGE_MAKERELATION_LOC+"])")
  400.     FOR m.nLoop = 1 TO m.nTotal_Relations
  401.         REPLACE Program WITH CRLF + "FUNCTION MakeRelation_"+TRANS(m.nLoop)+CRLF+;
  402.                              "ALTER TABLE '" + aAll_Relations(m.nLoop, 1) +;
  403.                              "' ADD FOREIGN KEY TAG " +;
  404.                              aAll_Relations(m.nLoop, 3) +;
  405.                              " REFERENCES " + ;
  406.                              aAll_Relations(m.nLoop, 2) +;
  407.                              " TAG " + aAll_Relations(m.nLoop, 4) + ;
  408.                              CRLF +"ENDFUNC"+CRLF+CRLF ADDITIVE
  409.         UpdateProcArray("MakeRelation_"+TRANS(m.nLoop)+"()")
  410.     Stat_Message()
  411.     ENDFOR
  412. ENDIF
  413.  
  414. CLOSE DATABASE  && Because we're going to start peeking into the
  415.                 && table structure of the DBC
  416.  
  417. **************************
  418. *** Get RI Info
  419. **************************
  420. IF m.nTotal_Relations > 0
  421.     DO GetRI WITH "GenDBC.tmp"
  422.     IF FILE("GenDBC.tmp")
  423.         USE GenDBC EXCLUSIVE
  424.         APPEND MEMO Program FROM "GenDBC.tmp"
  425.         USE
  426.         ERASE "GenDBC.tmp"
  427.         UpdateProcArray("DisplayStatus(["+MESSAGE_MAKERI_LOC+"])")
  428.         UpdateProcArray("MakeRI()")
  429.     ENDIF
  430. ENDIF
  431. UpdateProcArray("DisplayStatus(["+MESSAGE_DONE_LOC+"])")
  432. Stat_Message()
  433.  
  434. *! Make it a permanent file
  435. USE GenDBC EXCLUSIVE
  436. lcprocstr = ""
  437. FOR i = 1 TO ALEN(g_aprocs)
  438.     lcprocstr = lcprocstr + g_aprocs[m.i] + CRLF
  439. ENDFOR
  440. lcMessageStr =  "FUNCTION DisplayStatus(lcMessage)"+CRLF+;
  441.                 "WAIT WINDOW NOWAIT lcMessage"+CRLF+;
  442.                 "ENDFUNC"            
  443. REPLACE Program WITH HEADING_1_LOC + "* * " + DTOC(DATE()) +;
  444.                      SPACE(19 - LEN(m.g_cDatabase) / 2) + ;
  445.                      m.g_cDatabase + SPACE(19 - LEN(m.g_cDatabase) / 2) +;
  446.                      TIME() + CRLF + HEADING_2_LOC + CRLF + ;
  447.                      IIF(!EMPTY(m.g_cFilterExp), NS_COMMENT_LOC +  m.g_cFilterExp + ;
  448.                      CRLF + REPLICATE("*", 52) + CRLF, "") + ;
  449.                      CRLF + lcprocstr + CRLF + Program +;
  450.                      CRLF + lcMessageStr +CRLF
  451.                                          
  452. COPY MEMO Program TO (m.cOutFile)
  453. USE
  454. ERASE "GenDBC.DBF"
  455. ERASE "GenDBC.FPT"
  456.  
  457. Stat_Message()
  458.  
  459. *! Exit Program
  460. COMPILE (m.cOutFile)
  461. GenDBC_CleanUp(.T.)
  462. *********************** END OF PROGRAM ***********************
  463.  
  464. **************************************************************************
  465. **
  466. ** Function Name: GETRI(<ExpC>)
  467. ** Creation Date: 1994.12.02
  468. ** Purpose:
  469. **
  470. **      To take existing FoxPro 3.0/5.0 RI Infomration, and generate an output
  471. **      program that can be used to "re-create" this.
  472. **
  473. ** Parameters:
  474. **
  475. **      cOutFileName - A character string containing the name of the
  476. **                     output file
  477. **
  478. ** Modification History:
  479. **
  480. **  1995.01.05  KRT        Created function
  481. **  1995.12.20  KRT        Allow better lookup when trying to find
  482. **                        the right record to add the RI information
  483. **************************************************************************
  484. PROCEDURE GetRI
  485.     LPARAMETERS m.cOutFileName
  486.  
  487.     PRIVATE ALL EXCEPT g_*
  488.  
  489.     *! Create the output file
  490.     m.hGTFile = FCREATE(m.cOutFileName)
  491.     IF m.hGTFile < 1
  492.         FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
  493.     ENDIF
  494.  
  495.     *! USE the database
  496.     USE (m.g_cFullDatabase) EXCLUSIVE
  497.  
  498.     LOCATE FOR ObjectType = "Relation" AND !EMPTY(RiInfo)
  499.     IF FOUND()
  500.         WriteFile(m.hGTFile, "FUNCTION MakeRI")
  501.         WriteFile(m.hGTFile, "***** " + BEGIN_RI_LOC + " *****")
  502.         WriteFile(m.hGTFile, "CLOSE DATABASE")
  503.         WriteFile(m.hGTFile, "USE '" +  m.g_cDatabase + "'")
  504.         DO WHILE FOUND()
  505.             *! Have to get the parent name to verify we are adding
  506.             *! Information to the right record.
  507.             m.nParentID = ParentID
  508.             *! We use select so we won't mess up our LOCATE ... CONTINUE command
  509.             SELECT ObjectName FROM (m.g_cFullDatabase) WHERE ObjectID = nParentID INTO ARRAY aTableName
  510.             m.nStart = 1
  511.             m.cITag = ""
  512.             m.cTable = ""
  513.             m.cRTag = ""
  514.             DO WHILE m.nStart <= LEN(Property)
  515.                 nSize = ASC(SUBSTR(Property, m.nStart, 1)) +;
  516.                 (ASC(SUBSTR(Property, m.nStart + 1, 1)) * 256) +;
  517.                 (ASC(SUBSTR(Property, m.nStart + 2, 1)) * 256^2) + ;
  518.                 (ASC(SUBSTR(Property, m.nStart + 3, 1)) * 256^3)
  519.  
  520.                 m.nKey = ASC(SUBSTR(Property, m.nStart + 6, 1))
  521.  
  522.                 DO CASE
  523.                     CASE m.nKey = 13
  524.                         m.cITag = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
  525.                     CASE m.nKey = 18
  526.                         m.cTable = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
  527.                     CASE m.nKey = 19
  528.                         m.cRTag = SUBSTR(Property, m.nStart + 7, m.nSize - 8)
  529.                 ENDCASE
  530.                 m.nStart = m.nStart + m.nSize
  531.             ENDDO
  532.             WriteFile(m.hGTFile, "LOCATE FOR ObjectType = 'Table' AND ObjectName = '" + ;
  533.                          ALLTRIM(aTableName(1)) + "'")
  534.             WriteFile(m.hGTFile, "IF FOUND()")
  535.             WriteFile(m.hGTFile, "    nObjectID = ObjectID")
  536.             WriteFile(m.hGTFile, "    LOCATE FOR ObjectType = 'Relation' AND '" + m.cITag + ;
  537.                         "'$Property AND '" + m.cTable + "'$Property AND '" + m.cRTag + ;
  538.                         "'$Property AND ParentID = nObjectID")
  539.             WriteFile(m.hGTFile, "    IF FOUND()")
  540.             WriteFile(m.hGTFile, "          REPLACE RiInfo WITH '" + RiInfo + "'")
  541.             WriteFile(m.hGTFile, "    ELSE")
  542.             WriteFile(m.hGTFile, '       ? "' + NO_FIND_LOC + '"')
  543.             WriteFile(m.hGTFile, "    ENDIF")
  544.             WriteFile(m.hGTFile, "ENDIF")
  545.             CONTINUE
  546.         ENDDO
  547.         WriteFile(m.hGTFile, "USE")
  548.         WriteFile(m.hGTFile, "ENDFUNC")
  549.         WriteFile(m.hGTFile, "")
  550.         FCLOSE(m.hGTFile)
  551.     ELSE
  552.         FCLOSE(m.hGTFile)
  553.     ERASE (m.cOutFileName)
  554.     ENDIF
  555.     USE
  556. RETURN
  557.  
  558. **************************************************************************
  559. **
  560. ** Function Name: GETTABLE(<ExpC>, <ExpC>)
  561. ** Creation Date: 1994.12.01
  562. ** Purpose        :
  563. **
  564. **              To take an existing FoxPro 3.0/5.0 Table, and generate an output
  565. **              program that can be used to "re-create" that Table.
  566. **
  567. ** Parameters:
  568. **
  569. **      cTableName   -  A character string representing the name of the
  570. **                      existing Table
  571. **      cOutFileName -  A character string containing the name of the
  572. **                      output file
  573. **
  574. ** Modification History:
  575. **
  576. **  1994.12.02  KRT             Created function
  577. **  1994.12.05  KRT             Made it a function and cleaned it up
  578. **  1994.12.08  KRT             Assume Database is open to speed up operation
  579. **  1995.09.15  KRT             Use DBF() to find the real table name
  580. **  1995.09.15  KRT             Take into account CR+LF in comment fields
  581. **  1996.04.12  KRT             Added new properties for Visual FoxPro 5.0
  582. **                              InputMask / Format / DisplayClass
  583. **                              DisplayClassLibrary
  584. **  1996.06.01  KRT             Added support for Collate sequence on index
  585. **************************************************************************
  586. PROCEDURE GetTable
  587.     LPARAMETERS m.cTableName, m.cOutFileName
  588.  
  589.     PRIVATE ALL EXCEPT g_*
  590.  
  591.     *! Create the output file
  592.     m.hGTFile = FCREATE(m.cOutFileName)
  593.     IF m.hGTFile < 1
  594.         FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
  595.     ENDIF
  596.  
  597.     *! Open Table to get field info
  598.     USE (m.cTableName) EXCLUSIVE
  599.  
  600.     *! Get all the fields
  601.     m.nNumberOfFields = AFIELDS(aAll_Fields)
  602.  
  603.     *! Header Information
  604.     WriteFile(m.hGTFile, "FUNCTION MakeTable_"+FIXNAME(m.cTableName))
  605.     WriteFile(m.hGTFile, "***** " + BEGIN_TABLE_LOC + m.cTableName + " *****")
  606.  
  607.     *! NOTE * NOTE * NOTE
  608.     *! If the table is greater than 8 characters then it will fail on platforms that
  609.     *! do not support this (Such as Win32s).
  610.     m.cOldSetFullPath = SET("FULLPATH")
  611.     SET FULLPATH OFF
  612.     m.cTableFileName = DBF(ALIAS())
  613.     SET FULLPATH &cOldSetFullPath
  614.     m.cTableFileName = SUBSTR(m.cTableFileName, RAT(":", m.cTableFileName) + 1)
  615.     m.cCreateTable = "CREATE TABLE '" + m.cTableFileName + "' NAME '" + m.cTableName + "' ("
  616.     
  617.     *! Information about each field that can been written with CREATE TABLE - SQL
  618.     FOR m.nInner_Loop = 1 TO m.nNumberOfFields
  619.         IF m.nInner_Loop = 1
  620.             m.cCreateTable = m.cCreateTable + aAll_Fields(m.nInner_Loop, 1) + " "
  621.         ELSE
  622.             m.cCreateTable = SPACE(LEN(m.cTableName) + 15) + ;
  623.                             aAll_Fields(m.nInner_Loop, 1) + " "
  624.         ENDIF
  625.         m.cCreateTable = m.cCreateTable + aAll_Fields(m.nInner_Loop, 2)
  626.         DO CASE
  627.             CASE aAll_Fields(m.nInner_Loop, 2) == "C"
  628.                 m.cCreateTable = m.cCreateTable + "(" + ;
  629.                                 ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 3))) + ")"
  630.                 IF aAll_Fields(m.nInner_Loop, 6)
  631.                     m.cCreateTable = m.cCreateTable + " NOCPTRANS"
  632.                 ENDIF
  633.             CASE aAll_Fields(m.nInner_Loop, 2) == "M"
  634.                 IF aAll_Fields(m.nInner_Loop, 6)
  635.                     m.cCreateTable = m.cCreateTable + " NOCPTRANS"
  636.                 ENDIF
  637.             CASE aAll_Fields(m.nInner_Loop, 2) == "N" OR ;
  638.                 aAll_Fields(m.nInner_Loop, 2) == "F"
  639.                 cCreateTable = m.cCreateTable + "(" + ;
  640.                 ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 3))) + ;
  641.                 ", " + ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 4))) + ")"
  642.             CASE aAll_Fields(m.nInner_Loop, 2) == "B"
  643.                 m.cCreateTable = m.cCreateTable + "(" + ;
  644.                 ALLTRIM(STR(aAll_Fields(m.nInner_Loop, 4))) ;
  645.                 + ")"
  646.         ENDCASE
  647.  
  648.         IF aAll_Fields(m.nInner_Loop, 5)
  649.             m.cCreateTable = m.cCreateTable + " NULL"
  650.         ELSE
  651.             m.cCreateTable = m.cCreateTable + " NOT NULL"
  652.         ENDIF
  653.  
  654.         *! Get properties for fields
  655.         IF !EMPTY(aAll_Fields(m.nInner_Loop, 7))
  656.             m.cCreateTable = m.cCreateTable + " CHECK " + aAll_Fields(m.nInner_Loop, 7)
  657.         ENDIF
  658.  
  659.         IF !EMPTY(aAll_Fields(m.nInner_Loop, 8))
  660.             m.cCreateTable = m.cCreateTable + " ERROR " + aAll_Fields(m.nInner_Loop, 8)
  661.         ENDIF
  662.  
  663.         IF !EMPTY(aAll_Fields(m.nInner_Loop, 9))
  664.             m.cCreateTable = m.cCreateTable + " DEFAULT " + aAll_Fields(m.nInner_Loop, 9)
  665.         ENDIF
  666.  
  667.         IF m.nInner_Loop <> m.nNumberOfFields
  668.             m.cCreateTable = m.cCreateTable + ", ;"
  669.         ELSE
  670.             m.cCreateTable = m.cCreateTable + ")"
  671.         ENDIF
  672.  
  673.         WriteFile(m.hGTFile, m.cCreateTable)
  674.     ENDFOR
  675.  
  676.     *! Get Index Information
  677.     WriteFile(m.hGTFile, CRLF + "***** " + BEGIN_INDEX_LOC + m.cTableName + " *****")
  678.     m.cCollate = ""
  679.     FOR m.nInner_Loop = 1 TO TAGCOUNT()
  680.         m.cTag = UPPER(ALLTRIM(TAG(m.nInner_Loop)))
  681.         IF m.cCollate <> IDXCOLLATE(m.nInner_Loop)
  682.             m.cCollate = IDXCOLLATE(m.nInner_Loop)
  683.             WriteFile(m.hGTFile, "SET COLLATE TO '" + m.cCollate + "'")
  684.         ENDIF
  685.         IF !EMPTY(m.cTag)
  686.             DO CASE
  687.                 CASE PRIMARY(m.nInner_Loop)
  688.                      IF !EMPTY(SYS(2021, m.nInner_Loop))
  689.                          IF EMPTY(m.g_cFilterExp)
  690.                             MessageBox(NOT_SUPPORTED_LOC, 64, WARNING_TITLE_LOC)
  691.                         ENDIF
  692.                         m.g_cFilterExp = m.g_cFilterExp + CRLF + ;
  693.                                        TABLE_NAME_LOC + m.cTableName + CRLF + ;
  694.                                        PRIMARY_KEY_LOC + SYS(14, m.nInner_Loop) + CRLF + ;
  695.                                        FILTER_EXP_LOC + SYS(2021, m.nInner_Loop)
  696.                      ENDIF
  697.                      WriteFile(m.hGTFile, "ALTER TABLE '" + m.cTableName + ;
  698.                                   "' ADD PRIMARY KEY " + SYS(14, m.nInner_Loop) ;
  699.                                   + " TAG " + m.cTag)
  700.                 CASE CANDIDATE(m.nInner_Loop)
  701.                     IF EMPTY(SYS(2021, m.nInner_Loop))
  702.                         WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
  703.                                       " TAG " + m.cTag + " CANDIDATE")
  704.                     ELSE
  705.                          WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
  706.                                       " TAG " + m.cTag + " FOR " + SYS(2021, m.nInner_Loop) + ;
  707.                                       + " CANDIDATE")
  708.                     ENDIF
  709.                 CASE UNIQUE(m.nInner_Loop)
  710.                     IF(EMPTY(SYS(2021, m.nInner_Loop)))
  711.                        WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
  712.                                     " TAG " + m.cTag + " UNIQUE")
  713.                     ELSE
  714.                        WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop);
  715.                                     + " TAG " + m.cTag + " FOR " + SYS(2021, m.nInner_Loop) ;
  716.                                     + " UNIQUE")
  717.                     ENDIF
  718.                 OTHERWISE
  719.                     IF(EMPTY(SYS(2021, m.nInner_Loop)))
  720.                         WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop) + ;
  721.                             " TAG " + m.cTag + ;
  722.                             IIF(DESCENDING(m.nInner_Loop), " DESCENDING ", ""))
  723.                     ELSE
  724.                         WriteFile(m.hGTFile, "INDEX ON " + SYS(14, m.nInner_Loop);
  725.                             + " TAG " + m.cTag + " FOR " + SYS(2021, m.nInner_Loop) + ;
  726.                             IIF(DESCENDING(m.nInner_Loop), " DESCENDING ", ""))
  727.                     ENDIF                    
  728.             ENDCASE
  729.         ELSE
  730.             EXIT FOR
  731.         ENDIF
  732.     ENDFOR
  733.  
  734.     *! Get Properties For Table
  735.     WriteFile(hGTFile, CRLF + "***** " + BEGIN_PROP_LOC + m.cTableName + " *****")
  736.     FOR m.nInner_Loop = 1 TO m.nNumberOfFields
  737.         m.cFieldAlias = m.cTableName + "." + aAll_Fields(m.nInner_Loop, 1)
  738.         m.cFieldHeaderAlias = [DBSETPROP('] + m.cFieldAlias + [', 'Field', ]
  739.         m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Caption")
  740.         IF !EMPTY(cTemp)
  741.             m.cTemp = STRTRAN(m.cTemp, ["], ['])
  742.             WriteFile(hGTFile, m.cFieldHeaderAlias + ['Caption', "] + m.cTemp + [")])
  743.         ENDIF
  744.         m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Comment")
  745.         IF !EMPTY(m.cTemp)
  746.             m.cTemp = STRTRAN(m.cTemp, ["], ['])
  747.             *! Strip Line Feeds
  748.             m.cTemp = STRTRAN(m.cTemp, CHR(10)) 
  749.             *! Convert Carriage Returns To Programmatic Carriage Returns
  750.             m.cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
  751.             WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['Comment', "] + m.cTemp + [")])
  752.         ENDIF
  753.         m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "InputMask")
  754.         IF !EMPTY(m.cTemp)
  755.             m.cTemp = STRTRAN(m.cTemp, ["], ['])
  756.             WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['InputMask', "] + m.cTemp + [")])
  757.         ENDIF
  758.         m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Format")
  759.         IF !EMPTY(m.cTemp)
  760.             m.cTemp = STRTRAN(m.cTemp, ["], ['])
  761.             WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['Format', "] + m.cTemp + [")])
  762.         ENDIF
  763.         
  764.         m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClass")
  765.         IF !EMPTY(m.cTemp)
  766.             m.cTemp = STRTRAN(m.cTemp, ["], ['])
  767.             WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['DisplayClass', "] + m.cTemp + [")])
  768.         ENDIF
  769.  
  770.         m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClassLibrary")
  771.         IF !EMPTY(m.cTemp)
  772.             m.cTemp = STRTRAN(m.cTemp, ["], ['])
  773.             WriteFile(m.hGTFile, m.cFieldHeaderAlias + ['DisplayClassLibrary', "] + m.cTemp + [")])
  774.         ENDIF
  775.     ENDFOR
  776.     
  777.     m.cTemp = DBGETPROP(m.cTableName, "Table", "Comment")
  778.     IF !EMPTY(m.cTemp)
  779.         m.cTemp = STRTRAN(m.cTemp, ["], ['])
  780.                 *! Strip Line Feeds
  781.                 m.cTemp = STRTRAN(m.cTemp, CHR(10))
  782.                 *! Convert Carriage Returns To Programmatic Carriage Returns
  783.                 m.cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
  784.         WriteFile(m.hGTFile, [DBSETPROP('] + m.cTableName + [', 'Table', ] + ['Comment', "] + m.cTemp + [")])
  785.     ENDIF
  786.  
  787.     m.cTemp = DBGETPROP(m.cTableName, "Table", "DeleteTrigger")
  788.     IF !EMPTY(m.cTemp)
  789.         WriteFile(hGTFile, "CREATE TRIGGER ON '" + m.cTableName + ;
  790.                               "' FOR DELETE AS " + m.cTemp)
  791.     ENDIF
  792.  
  793.     m.cTemp = DBGETPROP(m.cTableName, "Table", "InsertTrigger")
  794.     IF !EMPTY(m.cTemp)
  795.         WriteFile(m.hGTFile, "CREATE TRIGGER ON '" + m.cTableName + ;
  796.                               "' FOR INSERT AS " + m.cTemp)
  797.     ENDIF
  798.  
  799.     m.cTemp = DBGETPROP(m.cTableName, "Table", "UpdateTrigger")
  800.     IF !EMPTY(m.cTemp)
  801.         WriteFile(m.hGTFile, "CREATE TRIGGER ON '" + m.cTableName + ;
  802.                               "' FOR UPDATE AS " + m.cTemp)
  803.     ENDIF
  804.  
  805.     m.cTemp = DBGETPROP(m.cTableName, "Table", "RuleExpression")
  806.     IF !EMPTY(m.cTemp)
  807.         m.cError = DBGETPROP(m.cTableName, "Table", "RuleText")
  808.         IF !EMPTY(cError)
  809.             WriteFile(m.hGTFile, "ALTER TABLE '" + m.cTableName + ;
  810.                                   "' SET CHECK " + m.cTemp + " ERROR " + ;
  811.                                   m.cError)
  812.         ELSE
  813.             WriteFile(m.hGTFile, "ALTER TABLE '" + m.cTableName + ;
  814.                                   "' SET CHECK " + m.cTemp)
  815.         ENDIF
  816.     ENDIF
  817.     WriteFile(m.hGTFile, "ENDFUNC")
  818.     WriteFile(m.hGTFile, "")
  819.     FCLOSE(m.hGTFile)
  820. RETURN
  821.  
  822. **************************************************************************
  823. **
  824. ** Function Name: GETVIEW(<ExpC>, <ExpC>)
  825. ** Creation Date: 1994.12.01
  826. ** Purpose        :
  827. **
  828. **              To take an existing FoxPro 3.0/5.0 View, and generate an output
  829. **              program that can be used to "re-create" that view.
  830. **
  831. ** Parameters:
  832. **
  833. **      cViewName    -  A character string representing the name of the 
  834. **                      existing view
  835. **      cOutFileName -  A character string containing the name of the 
  836. **                      output file
  837. **
  838. ** Modification History:
  839. **
  840. **  1994.12.01  JHL             Created Program, runs on Build 329 of FoxPro 3.0
  841. **  1994.12.02  KRT             Added to GenDBC, removed third parameter, cleaned up
  842. **  1994.12.08  KRT             Assume Database is open to speed up operation
  843. **  1996.04.12  KRT             Added new properties for Visual FoxPro 5.0
  844. **                              Prepared / CompareMemo / FetchAsNeeded
  845. **    1996.05.14  KRT             Added more properties for views
  846. **     1996.05.16  KRT             Adjusted for return a blank string instead of a logical
  847. **                              value on Prepared, etc.. if the field does not exist
  848. **                              in the database (Version 3.0 database converted to 5.0)
  849. **  1996.05.16  KRT             Added the DataType property
  850. **  1996.06.26  KRT             Added support for ParameterList
  851. **  1996.07.19  KRT             Added support for Offline Views
  852. **  1996.08.07  KRT                Added support for BatchUpdateCount, Comment
  853. ***************************************************************************************
  854. PROCEDURE GetView
  855.  
  856.     LPARAMETERS cViewName, cOutFileName
  857.  
  858.     PRIVATE ALL EXCEPT g_*
  859.  
  860.     m.nFileHand = FCREATE(m.cOutFileName, 0)
  861.     IF m.nFileHand < 1
  862.         FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
  863.     ENDIF
  864.  
  865.     *! Get View Information for later use
  866.     m.nSourceType = DBGetProp(m.cViewName, 'View', 'SourceType')
  867.     m.cConnectName = ALLTRIM(DBGetProp(m.cViewName, 'View', 'ConnectName'))
  868.     m.cSQL = ALLTRIM(DBGetProp(m.cViewName, 'View', 'SQL'))
  869.     m.cnUpdateType = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'UpdateType')))
  870.     m.cnWhereType = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'WhereType')))
  871.     m.clFetchMemo = IIF(DBGetProp(m.cViewName, 'View', 'Fetchmemo'),'.T.','.F.')
  872.     m.clShareConnection = IIF(DBGetProp(m.cViewName, 'View', 'ShareConnection'),'.T.','.F.')
  873.     m.clSendUpdates = IIF(DBGetProp(m.cViewName, 'View', 'SendUpdates'),'.T.','.F.')
  874.     m.cnUseMemoSize = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'UseMemoSize')))
  875.     m.cnFetchSize = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'FetchSize')))
  876.     m.cnMaxRecords = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'MaxRecords')))
  877.     m.ccTables = ALLTRIM(DBGetProp(m.cViewName, 'View', 'Tables'))
  878.     m.clPrepared = IIF(!EMPTY(DBGetProp(m.cViewName, 'View', 'Prepared')), '.T.', '.F.')
  879.     m.clCompareMemo = IIF(!EMPTY(DBGetProp(m.cViewName, 'View', 'CompareMemo')), '.T.', '.F.')
  880.     m.clFetchAsNeeded = IIF(!EMPTY(DBGetProp(m.cViewName, 'View', 'FetchAsNeeded')), '.T.', '.F.')
  881.     m.cParams = ALLTRIM(DBGetProp(m.cViewName, 'View', 'ParameterList'))
  882.     m.lOffline = DBGetProp(m.cViewName, 'View', 'Offline')
  883.     m.cComment = DBGETPROP(m.cViewName, 'View', 'Comment')
  884.     IF !EMPTY(m.cComment )
  885.         m.cComment = STRTRAN(m.cComment , ["], ['])
  886.         *! Strip Line Feeds
  887.         m.cComment = STRTRAN(m.cComment , CHR(10)) 
  888.         *! Convert Carriage Returns To Programmatic Carriage Returns
  889.         m.cComment = STRTRAN(m.cComment , CHR(13), '" + CHR(13) + "')
  890.     ENDIF
  891.     m.cnBatchUpdateCount = ALLTRIM(STR(DBGetProp(m.cViewName, 'View', 'BatchUpdateCount')))
  892.     
  893.     *! Generate Comment Block
  894.     WriteFile(m.nFileHand, "FUNCTION MakeView_"+FIXNAME(m.cViewName))
  895.  
  896.     m.cCommentBlock = "***************** " + BEGIN_VIEW_LOC + m.cViewName + ;
  897.                       " ***************" + CRLF
  898.  
  899.     WriteFile(m.nFileHand, m.cCommentBlock)
  900.  
  901.     *! Generate CREATE VIEW command
  902.     m.cCreateString = 'CREATE SQL VIEW "'+ALLTRIM(m.cViewName)+'" ; '+CRLF
  903.  
  904.     IF m.nSourceType != 1     && If it isn't a local view
  905.         m.cCreateString = m.cCreateString + '   REMOTE '
  906.         IF !EMPTY(m.cConnectName)
  907.             m.cCreateString = m.cCreateString + 'CONNECT "' + m.cConnectName + '" ; '+CRLF
  908.         ENDIF
  909.     ENDIF
  910.     m.cCreateString = m.cCreateString + '   AS '+ m.cSQL + CRLF
  911.  
  912.     WriteFile(m.nFileHand, m.cCreateString)
  913.  
  914.     *! GENERATE code to Set View Level Properties
  915.     m.cViewDBSetPrefix = [DBSetProp(']+m.cViewName+[', 'View', ]
  916.  
  917.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['UpdateType', ] + m.cnUpdateType + [)])
  918.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['WhereType', ] + m.cnWhereType + [)])
  919.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchMemo', ] + m.clFetchMemo + [)])
  920.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['SendUpdates', ] + m.clSendUpdates + [)])
  921.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['UseMemoSize', ] + m.cnUseMemoSize + [)])
  922.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchSize', ] + m.cnFetchSize + [)])
  923.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['MaxRecords', ] + m.cnMaxRecords + [)])
  924.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['Tables', '] + m.ccTables + [')])
  925.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['Prepared', ] + m.clPrepared + [)])
  926.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['CompareMemo', ] + m.clCompareMemo + [)])
  927.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchAsNeeded', ] + m.clFetchAsNeeded + [)])
  928.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['FetchSize', ] + m.cnFetchSize + [)])
  929.     IF !EMPTY(m.cParams)
  930.         WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['ParameterList', "] + m.cParams + [")])
  931.     ENDIF
  932.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['Comment', "] +  m.cComment + [")])
  933.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['BatchUpdateCount', ] + m.cnBatchUpdateCount + [)])
  934.     WriteFile(m.nFileHand, m.cViewDBSetPrefix + ['ShareConnection', ] + m.clShareConnection + [)])
  935.     IF m.lOffline
  936.         WriteFile(m.nFileHand, 'CREATEOFFLINE("' + m.cViewName + '")')
  937.     ENDIF
  938.         
  939.  
  940.     *! GENERATE code to Set Field Level Properties
  941.     USE (DBC()) AGAIN IN 0 ALIAS GenViewCursor EXCLUSIVE
  942.     SELECT GenViewCursor
  943.     LOCATE FOR ALLTRIM(UPPER(GenViewCursor.ObjectName)) == m.cViewName AND ;
  944.         GenViewCursor.ObjectType = 'View'
  945.     m.nObjectId = GenViewCursor.ObjectId
  946.     SELECT ObjectName FROM GenViewCursor ;
  947.             WHERE GenViewCursor.ParentId = m.nObjectId ;
  948.             INTO ARRAY aViewFields
  949.     USE in GenViewCursor
  950.     WriteFile(m.nFileHand, CRLF + '*!* Field Level Properties for ' + m.cViewName)
  951.  
  952.     IF _TALLY # 0
  953.         FOR m.nLoop = 1 TO ALEN(aViewFields, 1)
  954.             m.cFieldAlias = m.cViewName + "." + ALLTRIM(aViewFields(nLoop, 1))
  955.             m.clKeyField = IIF(DBGetProp(m.cFieldAlias, 'Field', 'KeyField'),'.T.','.F.')
  956.             m.clUpdatable = IIF(DBGetProp(m.cFieldAlias, 'Field', 'Updatable'),'.T.','.F.')
  957.             m.ccUpdateName = ALLTRIM(DBGetProp(m.cFieldAlias, 'Field', 'UpdateName'))
  958.             m.cViewFieldSetPrefix = [DBSetProp(']+m.cFieldAlias+[', 'Field', ]
  959.             
  960.             WriteFile(m.nFileHand, '* Props for the '+m.cFieldAlias+' field.')
  961.             WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['KeyField', ] + m.clKeyField + [)])
  962.             WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Updatable', ] + m.clUpdatable + [)])
  963.             WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['UpdateName', '] + m.ccUpdateName + [')])
  964.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "RuleExpression")
  965.             IF !EMPTY(m.cTemp)
  966.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  967.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['RuleExpression', "]+m.cTemp+[")])
  968.             ENDIF
  969.             
  970.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "RuleText")
  971.             IF !EMPTY(m.cTemp)
  972.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  973.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['RuleText', "]+m.cTemp+[")])
  974.             ENDIF
  975.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Caption")
  976.             IF !EMPTY(m.cTemp)
  977.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  978.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Caption', "] + m.cTemp + [")])
  979.             ENDIF
  980.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Comment")
  981.             IF !EMPTY(m.cTemp)
  982.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  983.                 *! Strip Line Feeds
  984.                 m.cTemp = STRTRAN(m.cTemp, CHR(10)) 
  985.                 *! Convert Carriage Returns To Programmatic Carriage Returns
  986.                 m.cTemp = STRTRAN(m.cTemp, CHR(13), '" + CHR(13) + "')
  987.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Comment', "] + m.cTemp + [")])
  988.             ENDIF
  989.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "InputMask")
  990.             IF !EMPTY(m.cTemp)
  991.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  992.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['InputMask', "] + m.cTemp + [")])
  993.             ENDIF
  994.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "Format")
  995.             IF !EMPTY(m.cTemp)
  996.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  997.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['Format', "] + m.cTemp + [")])
  998.             ENDIF
  999.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClass")
  1000.             IF !EMPTY(m.cTemp)
  1001.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  1002.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DisplayClass', "] + m.cTemp + [")])
  1003.             ENDIF
  1004.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DisplayClassLibrary")
  1005.             IF !EMPTY(m.cTemp)
  1006.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  1007.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DisplayClassLibrary', "] + m.cTemp + [")])
  1008.             ENDIF
  1009.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DataType")
  1010.             IF !EMPTY(m.cTemp)
  1011.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DataType', "] + m.cTemp + [")])
  1012.             ENDIF
  1013.             m.cTemp = DBGETPROP(m.cFieldAlias, "Field", "DefaultValue")
  1014.             IF !EMPTY(m.cTemp)
  1015.                 m.cTemp = STRTRAN(m.cTemp, ["], ['])
  1016.                 WriteFile(m.nFileHand, m.cViewFieldSetPrefix + ['DefaultValue', "] + m.cTemp + [")])
  1017.             ENDIF
  1018.         ENDFOR
  1019.     ENDIF
  1020.  
  1021.     WriteFile(m.nFileHand, "ENDFUNC")
  1022.     WriteFile(m.nFileHand, " ")
  1023.  
  1024.     *! Close output file
  1025.     FCLOSE(m.nFileHand)
  1026.  
  1027. RETURN
  1028.  
  1029. **************************************************************************
  1030. **
  1031. ** Function Name: GETCONN(<ExpC>, <ExpC>)
  1032. ** Creation Date: 1995.01.03
  1033. ** Purpose        :
  1034. **
  1035. **              To take an existing FoxPro 3.0/5.0 Connection, and generate
  1036. **              an output program that can be used to "re-create" that connection.
  1037. **
  1038. ** Parameters:
  1039. **
  1040. **      cConnectName -  A character string representing the name of the 
  1041. **                      existing connection
  1042. **      m.cOutFileName -  A character string containing the name of the 
  1043. **                      output file
  1044. **
  1045. ** Modification History:
  1046. **
  1047. **  1995.01.03  JHL     Created Program, runs on Build 329 of FoxPro 3.0
  1048. **  1995.01.05  KRT     Incorporated into GenDBC with modifications
  1049. **  1996.04.12  KRT     Added new property for Visual FoxPro 5.0 (Database)
  1050. ***************************************************************************************
  1051. PROCEDURE GetConn
  1052.     LPARAMETERS cConnectionName, m.cOutFileName
  1053.  
  1054.     PRIVATE ALL EXCEPT g_*
  1055.  
  1056.     m.nFileHand = FCREATE(m.cOutFileName, 0)
  1057.     IF m.nFileHand < 1
  1058.         FatalAlert(NO_TEMP_FILE_LOC + m.cOutFileName, .T.)
  1059.     ENDIF
  1060.  
  1061.     *! Get Connection Information for later use
  1062.     m.clAsynchronous = IIF(DBGetProp(m.cConnectionName, 'Connection', 'Asynchronous'),'.T.','.F.')
  1063.     m.clBatchMode = IIF(DBGetProp(m.cConnectionName, 'Connection', 'BatchMode'),'.T.','.F.')
  1064.     m.ccComment = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'Comment'))
  1065.     m.ccConnectString = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'ConnectString'))
  1066.     m.cnConnectTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'ConnectTimeOut')))
  1067.     m.ccDataSource = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'DataSource'))
  1068.     m.cnDispLogin = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'DispLogin')))
  1069.     m.clDispWarnings = IIF(DBGetProp(m.cConnectionName, 'Connection', 'DispWarnings'),'.T.','.F.')
  1070.     m.cnIdleTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'IdleTimeOut')))
  1071.     m.ccPassword = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'Password'))
  1072.     m.cnQueryTimeOut = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'QueryTimeOut')))
  1073.     m.cnTransactions = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'Transactions')))
  1074.     m.ccUserId = ALLTRIM(DBGetProp(m.cConnectionName, 'Connection', 'UserId'))
  1075.     m.cnWaitTime = ALLTRIM(STR(DBGetProp(m.cConnectionName, 'Connection', 'WaitTime')))
  1076.     m.ccDatabase = DBGetProp(m.cConnectionName, 'Connection', 'Database')
  1077.  
  1078.     *! Generate Comment Block
  1079.     m.cCommentBlock = "***************** " + BEGIN_CONNECTIONS_LOC + " " + m.cConnectionName + ;
  1080.         " ***************" + CRLF
  1081.  
  1082.     WriteFile(m.nFileHand, "FUNCTION MakeConn_"+FIXNAME(m.cConnectionName))
  1083.     WriteFile(m.nFileHand, m.cCommentBlock)
  1084.  
  1085.     *! Generate CREATE Connection command
  1086.     m.cCreateString = 'CREATE CONNECTION '+ALLTRIM(m.cConnectionName)+' ; '+CRLF
  1087.  
  1088.     IF EMPTY(ALLTRIM(m.ccConnectString))  && If connectstring not specified
  1089.         m.cCreateString = m.cCreateString + '   DATASOURCE "' + ALLT(m.ccDataSource) + '" ; ' + CRLF
  1090.         m.cCreateString = m.cCreateString + '   USERID "' + ALLT(m.ccUserId) + '" ; ' + CRLF
  1091.         m.cCreateString = m.cCreateString + '   PASSWORD "'+ ALLT(m.ccPassword) + '"' + CRLF
  1092.     ELSE
  1093.         m.cCreateString = m.cCreateString + '   CONNSTRING "' + ALLT(m.ccConnectString) + '"'
  1094.     ENDIF
  1095.  
  1096.     WriteFile(m.nFileHand, m.cCreateString)
  1097.  
  1098.     *! GENERATE code to Set Connection Level Properties
  1099.     m.cConnectionDBSetPrefix = [DBSetProp(']+m.cConnectionName+[', 'Connection', ]
  1100.  
  1101.     m.cConnectionProps = '****' + CRLF
  1102.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1103.                         ['Asynchronous', ] + m.clAsynchronous + [)]+ CRLF
  1104.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1105.                         ['BatchMode', ] + m.clBatchMode + [)]+ CRLF
  1106.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1107.                         ['Comment', '] + m.ccComment + [')]+ CRLF
  1108.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1109.                         ['DispLogin', ] + m.cnDispLogin + [)]+ CRLF
  1110.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1111.                         ['ConnectTimeOut', ] + m.cnConnectTimeOut + [)]+ CRLF
  1112.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1113.                         ['DispWarnings', ] + m.clDispWarnings + [)]+ CRLF
  1114.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1115.                         ['IdleTimeOut', ] + m.cnIdleTimeOut + [)]+ CRLF
  1116.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1117.                         ['QueryTimeOut', ] + m.cnQueryTimeOut + [)]+ CRLF
  1118.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1119.                         ['Transactions', ] + m.cnTransactions + [)]+ CRLF
  1120.     m.cConnectionProps = m.cConnectionProps + m.cConnectionDBSetPrefix + ;
  1121.                         ['Database', '] + m.ccDatabase + [')] + CRLF
  1122.                         
  1123.     WriteFile(m.nFileHand, m.cConnectionProps)
  1124.     *! Close output file
  1125.     WriteFile(m.nFileHand, "ENDFUNC")
  1126.     WriteFile(m.nFileHand, " ")
  1127.  
  1128.     FCLOSE(m.nFileHand)
  1129. RETURN
  1130.  
  1131. **************************************************************************
  1132. **
  1133. ** Function Name: FATALALERT(<ExpC>)
  1134. ** Creation Date: 1994.12.02
  1135. ** Purpose:
  1136. **
  1137. **              Place a message box to alert user of a fatal error.
  1138. **
  1139. ** Parameters:
  1140. **
  1141. **      cAlert_Message - Message to display to user
  1142. **      lCleanup       - If we should try to restore environment
  1143. **
  1144. ** Modification History:
  1145. **
  1146. **      1994.12.02  KRT  Added to GenDBC
  1147. **************************************************************************
  1148. PROCEDURE FatalAlert
  1149.     LPARAMETERS cAlert_Message, lCleanup
  1150.  
  1151.     MESSAGEBOX(m.cAlert_Message, 16, ERROR_TITLE_LOC)
  1152.  
  1153.     GenDBC_CleanUp(m.lCleanup)
  1154.  
  1155.     CANCEL
  1156. RETURN
  1157.  
  1158. **************************************************************************
  1159. **
  1160. ** Function Name: GenDBC_CleanUp(<ExpL>)
  1161. ** Creation Date: 1995.03.01
  1162. ** Purpose:
  1163. **
  1164. **              Restore the environment
  1165. **
  1166. ** Parameters:
  1167. **
  1168. **      lCleanup - If we should try to restore tables open
  1169. **
  1170. ** Modification History:
  1171. **
  1172. **      1994.03.01  KRT         Added to GenDBC
  1173. **************************************************************************
  1174. PROCEDURE GenDBC_CleanUp
  1175.     LPARAMETERS lCleanup
  1176.  
  1177.     *! Restore everything
  1178.     IF !EMPTY(m.g_cOnError)
  1179.         ON ERROR &g_cOnError
  1180.     ELSE
  1181.         ON ERROR
  1182.     ENDIF
  1183.     
  1184.     IF !EMPTY(m.g_cSetTalk)
  1185.         SET TALK &g_cSetTalk
  1186.     ENDIF
  1187.     
  1188.     IF !EMPTY(m.g_cSetDeleted)
  1189.         SET DELETED &g_cSetDeleted
  1190.     ENDIF
  1191.     
  1192.     IF m.g_cSetStatusBar = "OFF"
  1193.         SET STATUS BAR OFF
  1194.     ENDIF
  1195.     
  1196.     IF !EMPTY(m.g_cStatusText)
  1197.         SET MESSAGE TO (m.g_cStatusText)
  1198.     ELSE
  1199.         SET MESSAGE TO
  1200.     ENDIF
  1201.     
  1202.     SET FULLPATH &g_cFullPath
  1203.     CLOSE ALL
  1204.  
  1205.     IF m.lCleanUp
  1206.         IF !EMPTY(m.g_cFullDatabase) AND m.lCleanUp == .T.
  1207.             OPEN DATABASE (m.g_cFullDatabase) EXCLUSIVE
  1208.             IF m.g_nTotal_Tables_Used > 0
  1209.                 FOR m.nLoop = 1 TO m.g_nTotal_Tables_Used
  1210.                     IF UPPER(JUSTEXT(m.g_aTables_Used(m.nLoop)))="TMP"
  1211.                         LOOP
  1212.                     ENDIF
  1213.                     USE (m.g_aTables_Used(m.nLoop)) IN (m.g_aAlias_Used(m.nLoop, 2)) EXCLUSIVE;
  1214.                         ALIAS (m.g_aAlias_Used(m.nLoop, 1))
  1215.                 ENDFOR
  1216.             ENDIF
  1217.         ENDIF
  1218.     ENDIF
  1219. RETURN
  1220.  
  1221. **************************************************************************
  1222. **
  1223. ** Function Name: WRITEFILE(<ExpN>, <ExpC>)
  1224. ** Creation Date: 1994.12.02
  1225. ** Purpose        :
  1226. **
  1227. **              Centralized file output routine to check for proper output
  1228. **
  1229. ** Parameters:
  1230. **
  1231. **      hFileHandle - Handle of output file
  1232. **      cText       - Contents to write to file
  1233. **
  1234. ** Modification History:
  1235. **
  1236. **      1994.12.02  KRT         Added to GenDBC
  1237. **************************************************************************
  1238. PROCEDURE WriteFile
  1239.     LPARAMETERS hFileHandle, cText
  1240.  
  1241.     m.nBytesSent = FPUTS(m.hFileHandle, m.cText)
  1242.     IF  m.nBytesSent < LEN(m.cText)
  1243.         FatalAlert(NO_OUTPUT_WRITTEN_LOC, .T.)
  1244.     ENDIF
  1245. RETURN
  1246.  
  1247. **************************************************************************
  1248. **
  1249. ** Function Name: GenDBC_Error(<expC>, <expN>)
  1250. ** Creation Date: 1994.12.02
  1251. ** Purpose        :
  1252. **
  1253. **              Generalized Error Routine
  1254. **
  1255. ** Parameters:
  1256. **
  1257. **      cMess   - Message to give user
  1258. **      nLineNo - Line Number Error Occurred
  1259. **
  1260. ** Modification History:
  1261. **
  1262. **      1994.12.02  KRT         Added to GenDBC
  1263. **************************************************************************
  1264. PROCEDURE GenDBC_Error
  1265.     LPARAMETERS cMess, nLineNo
  1266.  
  1267.     FatalAlert(UNRECOVERABLE_LOC + CRLF + m.cMess + CRLF + ;
  1268.                   AT_LINE_LOC + ALLTRIM(STR(m.nLineNo)), .T.)
  1269. RETURN
  1270.  
  1271. **************************************************************************
  1272. **
  1273. ** Function Name: Stat_Message()
  1274. ** Creation Date: 1994.01.08
  1275. ** Purpose        :
  1276. **
  1277. **              Generalized Status Bar Progression
  1278. **
  1279. ** Parameters:
  1280. **
  1281. **              None
  1282. **
  1283. ** Modification History:
  1284. **
  1285. **      1994.01.08  KRT         Added to GenDBC
  1286. **************************************************************************
  1287. PROCEDURE Stat_Message
  1288.     PRIVATE ALL EXCEPT g_*
  1289.     
  1290.     m.nStat = m.g_nCurrentStat * (160 / g_nMax)
  1291.     SET MESSAGE TO REPLICATE("|", m.nStat) + " " + ;
  1292.         ALLTRIM(STR(INT(100 * (m.g_nCurrentStat / m.g_nMax)))) + "%"
  1293.     m.g_nCurrentStat = m.g_nCurrentStat + 1
  1294. RETURN
  1295.  
  1296. **************************************************************************
  1297. **
  1298. ** Function Name: UpdateProcArray(<ExpC>)
  1299. ** Creation Date: 1997.10.22
  1300. ** Purpose        :
  1301. **
  1302. **              Update g_aprocs array with procedure name
  1303. **
  1304. ** Parameters:
  1305. **
  1306. **      cText       - Name of procedure to add to array
  1307. **
  1308. ** Modification History:
  1309. **
  1310. **      1997.10.22  RB         Added to GenDBC
  1311. **************************************************************************
  1312. PROCEDURE UpdateProcArray(lcProcName)
  1313.     IF g_lskipdisplay AND ATC("DisplayStatus",lcprocname)#0
  1314.         RETURN
  1315.     ENDIF 
  1316.     IF !EMPTY(g_aprocs[ALEN(g_aprocs)])
  1317.         DIMENSION g_aprocs[ALEN(g_aprocs)+1]
  1318.     ENDIF
  1319.     g_aprocs[ALEN(g_aprocs)] = lcProcName
  1320. ENDPROC
  1321.  
  1322. **************************************************************************
  1323. **
  1324. ** Function Name: FixName(<ExpC>)
  1325. ** Creation Date: 1997.10.22
  1326. ** Purpose        :
  1327. **
  1328. **              Fixes procedure name to remove bad chars
  1329. **
  1330. ** Parameters:
  1331. **
  1332. **      cText       - Name of procedure to add fix
  1333. **
  1334. ** Modification History:
  1335. **
  1336. **      1997.10.22  RB         Added to GenDBC
  1337. **************************************************************************
  1338. PROCEDURE FixName(lcProcName)
  1339.     lcProcName=ALLTRIM(lcProcName)
  1340.     IF VERSION(3) $ DBCS_LOC
  1341.         cbadchars = '/,-=:;!@#$%&*.<>()?[]\'+;
  1342.            '+'+CHR(34)+CHR(39)+" "
  1343.     ELSE
  1344.         cbadchars = 'üéâäàåçêëèïîÄÅÉæÆôöòûùÿÖÜáíóúñÑ/\,-=:;{}[]!@#$%^&*.<>()?'+;
  1345.            '+|Ç¢£¥₧ƒªº¿⌐¬½¼¡«»░▒▓│┤╡╢╖╕╣║╗╝╜╛┐└┴┬├─┼╞╟╚╔╩╦╠═╬╧'+;
  1346.            '╨╤╥╙╘╒╓╫╪┘┌█▄▌▐▀αßΓπΣσµτΦΘΩδ∞φε∩≡±≥≤⌠⌡÷≈°∙·√ⁿ²■'+CHR(34)+CHR(39)+" "
  1347.     ENDIF
  1348.     lcProcName = CHRTRAN(lcProcName,cbadchars ,REPL('_',LEN(cbadchars)))
  1349.     RETURN lcProcName
  1350. ENDPROC